perm filename DISPLY.SAI[PNT,HE]10 blob
sn#475346 filedate 1979-09-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 IFCR NOT DECLARATION($$PRGID) THENC
C00003 00003 ! basic display procedures
C00006 00004 ! display: inidpy,dpydraw,dpyfree
C00012 00005 ! display: tree_string,dpy_string
C00017 ENDMK
C⊗;
IFCR NOT DECLARATION($$PRGID) THENC
ENTRY;
BEGIN "DISPLY" ENDC
DEFINE $DISPLY=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
REQUIRE "DDLIB.HDR[PNT,HE]" SOURCE_FILE; ! calls DDLIB[SUB,SYS];
REQUIRE "III2DD.HDR[PNT,HE]" SOURCE_FILE; ! calls III2DD[sub,sys];
REQUIRE "DPYSYS.HDR[PNT,HE]" SOURCE_FILE; ! calls DISPLY[SUB,SYS];
DEFINE #MAXDPT = 10; ! #MAXDPT of frame tree for display;
! basic display procedures;
INTEGER ARRAY ∂BUF[1:1000];
INTEGER ∂CHWID; ! width of a character;
INTEGER ∂CHIGH; ! height of a line;
INTEGER ∂SIZE; ! size of the characters;
INTERNAL INTEGER ∂DLMAR;
INTEGER ∂DRMAR,∂DTMAR,∂DBMAR; ! whole display area;
INTEGER ∂TPMAR; ! typing space top margin;
INTEGER ∂SCFR; ! margin between frames and scalars;
INTEGER ∂FLRT; ! margin between files and rot's;
INTEGER ∂RTVT; ! margin between rot's and vectors;
INTEGER ∂SCDF; ! margin between defaults and scalars;
INTEGER ∂TRFL; ! trans's bottom margin;
INTEGER ∂UPLNS,∂DWNLNS; ! # of lines for frame tree and arithmetic;
INTEGER ∂WFR; ! width of space for frame tree;
INTEGER ∂WSC; ! width of space for scalars;
INTEGER ∂WRTVT; ! width of space for vectors,rot's;
INTEGER ARRAY PPINFTBL[0:23];
DEFINE PPIOT "[]" = ['702000000000];
DEFINE PPINFO "[]" = [PPIOT 5,];
BOOLEAN PROCEDURE ONDD;
START_CODE
PPINFO PPINFTBL[0];
MOVE 1,PPINFTBL[2];
TLNN 1,'100000;
TDZA 1,1;
SETO 1,;
END;
INTERNAL SIMPLE PROCEDURE DRAWLINE(INTEGER X0,Y0,X1,Y1);
BEGIN
AIVECT(X1,Y1);
AVECT(X0,Y0);
END;
SIMPLE PROCEDURE DRAWBOX(INTEGER X0,Y0,X1,Y1);
BEGIN
AIVECT(X0,Y0);
AVECT(X0,Y1);
AVECT(X1,Y1);
AVECT(X1,Y0);
AVECT(X0,Y0);
END;
PROCEDURE OUTBLK(STRING STR;INTEGER X,Y,WID,NLINES,SIZE);
BEGIN
INTEGER BRK,NCHAR;STRING S,T;LABEL L;
NCHAR←WID/∂CHWID;
WHILE STR DO
BEGIN
S←SCAN(STR,$DPYTAB,BRK);
IF BRK≠CR THEN DONE;
WHILE S DO
BEGIN
IF LENGTH(S)>NCHAR
THEN BEGIN
T←S[1 FOR NCHAR];S←S[NCHAR+1 FOR ∞];
END
ELSE BEGIN
T←S;S←NULL;
END;
AIVECT(X,Y);
DPYSST(T);
Y←Y-SIZE;
IF (NLINES←NLINES-1)≤0 THEN GO TO L;
END;
END;
L: END;
! display: inidpy,dpydraw,dpyfree;
INTERNAL SIMPLE PROCEDURE INIDPY;
BEGIN
∂CHIGH←20;
∂SIZE←2;
IF ONDD THEN
BEGIN
∂DLMAR←-625;
∂DRMAR←580;
∂DTMAR←450;
∂DBMAR←-510;
∂CHWID←15;
END
ELSE
BEGIN
∂DLMAR←-510;
∂DRMAR←510;
∂DTMAR←450;
∂DBMAR←-450; ! PROVA;
∂CHWID←12;
END;
∂TPMAR←∂DBMAR+(∂DTMAR-∂DBMAR)*0.20;
∂TRFL←-70; ! horizontal lines;
∂SCDF←-10;
∂SCFR←∂DRMAR-180; ! vertical lines;
∂FLRT←∂DLMAR+295;
∂RTVT←(∂DRMAR-∂FLRT)/2 + ∂FLRT;
∂WFR←∂SCFR-∂DLMAR-10; ! width;
∂WSC←∂DRMAR-∂SCFR-10;
∂WRTVT← ∂RTVT-∂FLRT - 10;
$NCHAR←∂WFR/∂CHWID;
∂UPLNS←(∂DTMAR-∂TRFL)/∂CHIGH; ! number of lines;
∂DWNLNS←(∂TRFL-∂TPMAR)/∂CHIGH;
$ARROW←15; ! initialization of arrow;
END;
IFC FALSE THENC
! draws an arrow drawing lines between the 7 points (1 to 7). The dimensions
of the arrow and the names of the variables used are
. 80 . 20 .
c3y ..................3.....................
. |\ . 10
c12y 1 ________________2| \ .................
| . \ .
c4y | . \4 20
| . /.
|__________________ /................
c67y 7. 6| / . 10
c5y ..................|/....................
. 5 .
. . .
c17x c2356x c4x ;
SIMPLE PROCEDURE ARROW;
BEGIN ! $ARROW is the arrow position;
INTEGER C17X,C2356X,C4X,C12Y,C3Y,C5Y,C67Y,I;
C17X←∂DLMAR-25;
C2356X←C17X+80;
C4X←C2356X+20;
C3Y←$ARROW-20;
C5Y←$ARROW+20;
C12Y←$ARROW-10;
C67Y←$ARROW+10;
DRAWLINE(C17X,C12Y,C2356X,C12Y);
DRAWLINE(C2356X,C12Y,C2356X,C3Y);
DRAWLINE(C2356X,C3Y,C4X,$ARROW);
DRAWLINE(C4X,$ARROW,C2356X,C5Y);
DRAWLINE(C2356X,C5Y,C2356X,C67Y);
DRAWLINE(C17X,C67Y,C2356X,C67Y);
DRAWLINE(C17X,C12Y,C17X,C67Y);
FOR I←C17X STEP 2 UNTIL C2356X DO
DRAWLINE(I,C12Y,I,C67Y);
FOR I←C2356X STEP 2 UNTIL C4X DO
DRAWLINE(I,C3Y+(I-C2356X),I,C5Y-(I-C2356X));
END;
ELSEC EXTERNAL SIMPLE PROCEDURE ARROW;
ENDC
INTERNAL SIMPLE PROCEDURE DPYDRAW;
BEGIN
DPYSET(∂BUF);
DPYBIG(∂SIZE);
TYPLOC(∂TPMAR-∂CHIGH,∂DBMAR);
DRAWBOX (∂DLMAR,∂DTMAR,∂DRMAR,∂TPMAR);
DRAWLINE(∂SCFR,∂DTMAR,∂SCFR,∂TRFL);
DRAWLINE(∂SCFR,∂SCDF,∂DRMAR,∂SCDF);
DRAWLINE(∂DLMAR,∂TRFL,∂DRMAR,∂TRFL);
DRAWLINE(∂FLRT,∂TRFL,∂FLRT,∂TPMAR);
DRAWLINE(∂RTVT,∂TRFL,∂RTVT,∂TPMAR);
ARROW;
END;
INTERNAL SIMPLE PROCEDURE DPYFREE;
BEGIN
DPYCLR;DPYSET(∂BUF);
TYPLOC(∂DTMAR-∂CHIGH,∂TPMAR);DPYOUT(1); ! turns off the display;
END;
INTERNAL SIMPLE PROCEDURE OUTDPY;
BEGIN
OUTBLK($FRLST,
∂DLMAR+5,∂DTMAR-∂CHIGH-5,
∂WFR,∂UPLNS-6,∂CHIGH);
OUTBLK($SCLST,
∂SCFR+5,∂DTMAR-∂CHIGH-5,
∂WSC,∂UPLNS-4,∂CHIGH);
OUTBLK($DFLST,
∂SCFR+5,∂SCDF-∂CHIGH-5,
∂WSC,3,∂CHIGH);
OUTBLK($TRLST,
∂DLMAR+5,∂SCDF-2*∂CHIGH-5,
∂WFR,6,-∂CHIGH);
OUTBLK($VTLST,
∂RTVT+5,∂TRFL-∂CHIGH-5,
∂WRTVT,∂DWNLNS,∂CHIGH);
OUTBLK($RTLST,
∂FLRT+5,∂TRFL-∂CHIGH-5,
∂WRTVT,∂DWNLNS,∂CHIGH);
OUTBLK($OULST,
∂DLMAR+5,∂TRFL-∂CHIGH-5,
∂FLRT-∂DLMAR-10,∂DWNLNS-2,∂CHIGH);
OUTBLK($TTYFL&CRLF,
∂DLMAR+5,∂TPMAR + ∂CHIGH+5,
∂WRTVT,1,∂CHIGH);
END;
! display: tree_string,dpy_string;
! returns a string with the frame tree (names , trans part and affixment
type for frames);
INTERNAL RECURSIVE STRING PROCEDURE FRTREE(RPTR(FRAME) ND;INTEGER DEPTH);
BEGIN
STRING TS;INTEGER L;
DEPTH←DEPTH+1;
IF DEPTH>#MAXDPT THEN RETURN(NULL);
TS←NULL;
L←DEPTH*2-1; ! without arrow;
! L←DEPTH*2+3; ! with arrow;
TS←TS&$BLANK[1 FOR L]&"-+*"[1+FRAME:HOWLINKED[ND] FOR 1]&FRAME:PNAME[ND]
&CVSYM(FRAME:SYM[ND]);
IF LENGTH (TS)>$NCHAR
THEN TS←TS[1 TO $NCHAR-1]&CRLF&$BLANK[1 TO DEPTH*2-1]
&TS[$NCHAR TO ∞]&CRLF
ELSE TS←TS&CRLF;
ND←FRAME:SON[ND];
WHILE ND≠NULL_RECORD DO
BEGIN
TS←TS&FRTREE(ND,DEPTH);
ND←FRAME:EBRO[ND];
END;
RETURN(TS);
END;
STRING PROCEDURE TREE_STRING;
BEGIN
STRING TS;RPTR(FRAME)ND;
TS←"STATION (NILROTN,NILVECT)"&CRLF;
ND←FRAME:SON[F_WRLD];
WHILE ND≠NULL_RECORD DO
BEGIN
TS←TS&FRTREE(ND,0);
ND←FRAME:EBRO[ND];
END;
RETURN(TS);
END;
STRING PROCEDURE TYPR_STRING(INTEGER TYPE);
BEGIN
INTEGER I;RPTR(SYMBOL)ADDR;STRING TS;
TS←NULL;
! check only user defined variables;
FOR I←OFFSET[RES_OFFSET,TYPE]+1 STEP 1 UNTIL $ENTRY[TYPE] DO
IF ((ADDR←$YMTAB[TYPE,I])≠NULL_RECORD)
AND (SYMBOL:ACCESS[ADDR]=#PROCEDURE) THEN
TS←TS&" "&CVSYM(ADDR,TABLE_D);
RETURN(TS);
END;
STRING PROCEDURE PR_STRING(INTEGER TYPE);
BEGIN
INTEGER I;RPTR(SYMBOL)ADDR;STRING TS;
TS←NULL;
IF TYPE=#PR
THEN BEGIN
FOR I←1 STEP 1 UNTIL $ENTRY[#PR] DO
IF((ADDR←$YMTAB[#PR,I])≠NULL_RECORD)
THEN TS←TS&" "&CVSYM(ADDR,TABLE_D);
FOR I←#MIN STEP 1 UNTIL #BASIC_TYPES DO
TS←TS&TYPR_STRING(I);
END
ELSE TS←TYPR_STRING(TYPE-#MAX); ! find basic type;
RETURN(TS&CRLF);
END;
! returns a string with name and value of the variables of the
indicated type;
INTERNAL STRING PROCEDURE DPY_STRING(INTEGER TYPE);
BEGIN INTEGER I;
RPTR(SYMBOL)ADDR;STRING TS;
TS←NULL;
IF TYPE>#MAX OR TYPE=#PR THEN TS←PR_STRING(TYPE)
ELSE
IF TYPE=#FR THEN TS←TREE_STRING ELSE
FOR I←1 STEP 1 UNTIL $ENTRY[TYPE] DO
BEGIN
IF((ADDR←$YMTAB[TYPE,I])≠NULL_RECORD)
AND (SYMBOL:ACCESS[ADDR]=#SIMPLE)
AND ((SYMBOL:OFFSET[ADDR]<'400)
OR (SYMBOL:INDEX[ADDR] ≥ OFFSET[ARM_OFFSET,TYPE]))
THEN CASE TYPE OF
BEGIN "case"
[#SC][#VT][#RT][#TR][#EV]
TS←TS&" "&SYMBOL:PNAME[ADDR]&" "
&CVSYM(ADDR,TABLE_D)&CRLF;
[#MC] TS←TS&" "&MACRO:HEAD[SYMBOL:OBJECT[ADDR]]&" "
&CVSYM(ADDR,TABLE_D)&CRLF
END "case";
END;
RETURN (TS);
END;
END "DISPLY";